home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-13 / me_cd22.zip / MUTT2.ZIP / GANOI.MUT < prev    next >
Lisp/Scheme  |  1992-04-27  |  2KB  |  92 lines
  1. ;; ganoi.mut : Good ol towers of hanoi done "graphically"
  2. ;; Usage:
  3. ;;      (hanoi <n>)
  4. ;;          <n> - an integer number of discs
  5. ;; C Durland    Public Domain
  6.  
  7. (include me2.h)
  8.  
  9. (defun 
  10.   hanoi  MAIN
  11.   {
  12.     (int DISKS)
  13.  
  14.     (if (or (> (DISKS (convert-to NUMBER (ask "DISKS (max 9) = "))) 9)
  15.         (< DISKS 1))
  16.     { (msg "Bogus number of disks")(done) })
  17.     (set-up DISKS)
  18.     (transfer 0 1 2 DISKS)
  19.     (buffer-modified -1 FALSE)
  20.     (msg "done.")
  21.   }
  22.   transfer (from to via)(int n)
  23.   {
  24.     (if (== n 1)(move-disk from to)
  25.     {
  26.       (transfer from via to (- n 1))
  27.       (move-disk from to)
  28.       (transfer via to from (- n 1))
  29.     })
  30.   }
  31. )
  32.  
  33. (array int Pegs 3 20)    ; (Pegs n 0) ==> count
  34. (defun set-up (int disks)
  35. {
  36.   (int n)
  37.  
  38.   (Pegs 0 0 disks)(Pegs 1 0 (Pegs 2 0 0))
  39.   (n 1)(while (<= n disks){(Pegs 0 n (- disks n -1))(+= n 1)})
  40.   (switch-to-buffer "HANOI")
  41.   (clear-buffer)
  42.   (insert-text
  43. "              A                        B                        C")
  44.   (newline)(n 10)
  45.   (while (>= (n (- n 1)) 0)
  46.   {
  47.     (insert-text
  48. "              |                        |                        |        ")
  49.     (newline)
  50.   })
  51.     (insert-text
  52. "     ====================     ====================     ====================")
  53.   (n 1)
  54.   (while 
  55.   {
  56.     (put-a-disk (Pegs 0 n)(Pegs 0 n) n 0)
  57.     (<= (+= n 1) disks)
  58.   } ())
  59. })
  60.  
  61. (defun
  62.   move-disk (int from to)
  63.   {
  64.     (int a b d)
  65. ;(msg "move-disk: " (arg 0) " " (arg 1) " " (Pegs 0 0) " " (Pegs 1 0) " " (Pegs 2 0))(getchar)
  66.     (a (Pegs from 0))(b (+ (Pegs to 0) 1)) (d (Pegs from a))
  67.     (Pegs from 0 (- a 1))(Pegs to b d)(Pegs to 0 b)
  68.     (put-a-disk " "  d a from)(put-a-disk d d b to)
  69.   }
  70.   post (int n)
  71.   {
  72.     (switch n
  73.       0 15
  74.       1 40
  75.       2 65
  76.     )
  77.   }
  78.   move-to (int row col) { (goto-line row)(current-column col) }
  79.   put-a-disk    ; input: disk character, number of characters, row, post
  80.     (dchar)(int dn drow dpost)
  81.   {
  82.     (int row col n)
  83. ;(msg "put-a-disk \""(arg 0)"\" "(arg 1)" "(arg 2)" "(arg 3))(getchar)
  84.     (row (- 12 drow))(col (post dpost))
  85.     (n (+ (* 2 dn) 1))
  86.     (move-to row (- col (/ n 2)))
  87.     (while (<= 0 (n (- n 1))){(insert-text dchar)(delete-character)})
  88.     (move-to row col)(delete-character)(insert-text "|")
  89.     (update)
  90.   }
  91. )
  92.